home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / BITBLAST.FRM < prev    next >
Text File  |  1997-06-14  |  18KB  |  560 lines
  1. VERSION 5.00
  2. Begin VB.Form FBlit 
  3.    AutoRedraw      =   -1  'True
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Bit Blast"
  6.    ClientHeight    =   5904
  7.    ClientLeft      =   1356
  8.    ClientTop       =   1836
  9.    ClientWidth     =   8784
  10.    FillStyle       =   7  'Diagonal Cross
  11.    BeginProperty Font 
  12.       Name            =   "MS Sans Serif"
  13.       Size            =   7.8
  14.       Charset         =   0
  15.       Weight          =   700
  16.       Underline       =   0   'False
  17.       Italic          =   0   'False
  18.       Strikethrough   =   0   'False
  19.    EndProperty
  20.    ForeColor       =   &H00000000&
  21.    Icon            =   "BITBLAST.frx":0000
  22.    LinkTopic       =   "frmBlt"
  23.    MaxButton       =   0   'False
  24.    MinButton       =   0   'False
  25.    ScaleHeight     =   5904
  26.    ScaleWidth      =   8784
  27.    Begin VB.OptionButton optStretch 
  28.       Caption         =   "Stretch Delete"
  29.       Height          =   375
  30.       Index           =   2
  31.       Left            =   2040
  32.       TabIndex        =   15
  33.       Top             =   1200
  34.       Value           =   -1  'True
  35.       Width           =   1695
  36.    End
  37.    Begin VB.OptionButton optStretch 
  38.       Caption         =   "Stretch Or"
  39.       Height          =   375
  40.       Index           =   1
  41.       Left            =   2040
  42.       TabIndex        =   14
  43.       Top             =   840
  44.       Width           =   1695
  45.    End
  46.    Begin VB.OptionButton optStretch 
  47.       Caption         =   "Stretch And"
  48.       Height          =   375
  49.       Index           =   0
  50.       Left            =   2040
  51.       TabIndex        =   13
  52.       Top             =   480
  53.       Width           =   1695
  54.    End
  55.    Begin VB.CommandButton cmdMask 
  56.       Caption         =   "Mask"
  57.       Default         =   -1  'True
  58.       Height          =   495
  59.       Left            =   108
  60.       TabIndex        =   10
  61.       Top             =   720
  62.       Width           =   1695
  63.    End
  64.    Begin VB.CheckBox chkBitBlt 
  65.       Caption         =   "Use BitBlt"
  66.       Height          =   375
  67.       Left            =   2055
  68.       TabIndex        =   9
  69.       Top             =   120
  70.       Value           =   1  'Checked
  71.       Width           =   1695
  72.    End
  73.    Begin VB.CommandButton cmdExit 
  74.       Cancel          =   -1  'True
  75.       Caption         =   "Exit"
  76.       Height          =   495
  77.       Left            =   120
  78.       TabIndex        =   8
  79.       Top             =   2520
  80.       Width           =   1695
  81.    End
  82.    Begin VB.CommandButton cmdStretch 
  83.       Caption         =   "Stretch"
  84.       Height          =   495
  85.       Left            =   120
  86.       TabIndex        =   7
  87.       Top             =   1305
  88.       Width           =   1695
  89.    End
  90.    Begin VB.CommandButton cmdClear 
  91.       Caption         =   "Clear Destination"
  92.       Height          =   495
  93.       Left            =   120
  94.       TabIndex        =   6
  95.       Top             =   1920
  96.       Width           =   1695
  97.    End
  98.    Begin VB.CommandButton cmdBlit 
  99.       Caption         =   "Blit"
  100.       Height          =   495
  101.       Left            =   120
  102.       TabIndex        =   5
  103.       Top             =   120
  104.       Width           =   1695
  105.    End
  106.    Begin VB.ListBox lstROP 
  107.       Height          =   2160
  108.       Left            =   3840
  109.       Sorted          =   -1  'True
  110.       TabIndex        =   0
  111.       Top             =   120
  112.       Width           =   1455
  113.    End
  114.    Begin VB.PictureBox pbTest 
  115.       AutoRedraw      =   -1  'True
  116.       BackColor       =   &H00FFFFFF&
  117.       BorderStyle     =   0  'None
  118.       FillStyle       =   0  'Solid
  119.       Height          =   855
  120.       Index           =   3
  121.       Left            =   4425
  122.       ScaleHeight     =   852
  123.       ScaleWidth      =   852
  124.       TabIndex        =   4
  125.       Tag             =   "4"
  126.       Top             =   3960
  127.       Width           =   855
  128.    End
  129.    Begin VB.PictureBox pbTest 
  130.       AutoRedraw      =   -1  'True
  131.       BackColor       =   &H00FFFFFF&
  132.       BorderStyle     =   0  'None
  133.       FillStyle       =   6  'Cross
  134.       Height          =   855
  135.       Index           =   2
  136.       Left            =   3000
  137.       ScaleHeight     =   852
  138.       ScaleWidth      =   852
  139.       TabIndex        =   3
  140.       Tag             =   "3"
  141.       Top             =   3960
  142.       Width           =   855
  143.    End
  144.    Begin VB.PictureBox pbTest 
  145.       AutoRedraw      =   -1  'True
  146.       BackColor       =   &H00FFFFFF&
  147.       BorderStyle     =   0  'None
  148.       FillColor       =   &H0000FF00&
  149.       FillStyle       =   5  'Downward Diagonal
  150.       Height          =   855
  151.       Index           =   1
  152.       Left            =   1560
  153.       ScaleHeight     =   852
  154.       ScaleWidth      =   852
  155.       TabIndex        =   2
  156.       Tag             =   "2"
  157.       Top             =   3960
  158.       Width           =   855
  159.    End
  160.    Begin VB.PictureBox pbTest 
  161.       AutoRedraw      =   -1  'True
  162.       BackColor       =   &H00FFFFFF&
  163.       BorderStyle     =   0  'None
  164.       FillStyle       =   7  'Diagonal Cross
  165.       Height          =   855
  166.       Index           =   0
  167.       Left            =   120
  168.       ScaleHeight     =   57
  169.       ScaleMode       =   0  'User
  170.       ScaleWidth      =   57
  171.       TabIndex        =   1
  172.       Tag             =   "1"
  173.       Top             =   3960
  174.       Width           =   855
  175.    End
  176.    Begin VB.Image imgMarble 
  177.       Height          =   2664
  178.       Left            =   3660
  179.       Picture         =   "BITBLAST.frx":0CFA
  180.       Top             =   6396
  181.       Width           =   2952
  182.    End
  183.    Begin VB.Image imgBlank 
  184.       Height          =   975
  185.       Left            =   7695
  186.       Picture         =   "BITBLAST.frx":7904
  187.       Stretch         =   -1  'True
  188.       Top             =   6615
  189.       Width           =   900
  190.    End
  191.    Begin VB.Image imgHead 
  192.       Height          =   855
  193.       Left            =   660
  194.       Picture         =   "BITBLAST.frx":80C6
  195.       Stretch         =   -1  'True
  196.       Top             =   6465
  197.       Width           =   885
  198.    End
  199.    Begin VB.Label lbl 
  200.       BackColor       =   &H00FFFFFF&
  201.       BackStyle       =   0  'Transparent
  202.       Caption         =   "2"
  203.       ForeColor       =   &H00000000&
  204.       Height          =   225
  205.       Index           =   5
  206.       Left            =   1560
  207.       TabIndex        =   19
  208.       Top             =   3735
  209.       Width           =   180
  210.    End
  211.    Begin VB.Label lbl 
  212.       BackColor       =   &H00FFFFFF&
  213.       BackStyle       =   0  'Transparent
  214.       Caption         =   "3"
  215.       ForeColor       =   &H00000000&
  216.       Height          =   240
  217.       Index           =   4
  218.       Left            =   2985
  219.       TabIndex        =   18
  220.       Top             =   3735
  221.       Width           =   180
  222.    End
  223.    Begin VB.Label lbl 
  224.       BackColor       =   &H00FFFFFF&
  225.       BackStyle       =   0  'Transparent
  226.       Caption         =   "4"
  227.       ForeColor       =   &H00000000&
  228.       Height          =   255
  229.       Index           =   3
  230.       Left            =   4440
  231.       TabIndex        =   17
  232.       Top             =   3735
  233.       Width           =   165
  234.    End
  235.    Begin VB.Label lbl 
  236.       BackColor       =   &H00FFFFFF&
  237.       BackStyle       =   0  'Transparent
  238.       Caption         =   "1"
  239.       ForeColor       =   &H00000000&
  240.       Height          =   180
  241.       Index           =   2
  242.       Left            =   150
  243.       TabIndex        =   16
  244.       Top             =   3765
  245.       Width           =   180
  246.    End
  247.    Begin VB.Image imgSrcPoint 
  248.       Height          =   384
  249.       Left            =   336
  250.       Picture         =   "BITBLAST.frx":8868
  251.       Top             =   3492
  252.       Width           =   384
  253.    End
  254.    Begin VB.Image imgDstPoint 
  255.       Height          =   384
  256.       Left            =   360
  257.       Picture         =   "BITBLAST.frx":8B72
  258.       Top             =   4812
  259.       Width           =   384
  260.    End
  261.    Begin VB.Label lbl 
  262.       BackStyle       =   0  'Transparent
  263.       Caption         =   "Destination (right mouse button)"
  264.       ForeColor       =   &H000000FF&
  265.       Height          =   255
  266.       Index           =   1
  267.       Left            =   540
  268.       TabIndex        =   12
  269.       Top             =   5490
  270.       Width           =   2775
  271.    End
  272.    Begin VB.Label lbl 
  273.       BackColor       =   &H00C0C0C0&
  274.       BackStyle       =   0  'Transparent
  275.       Caption         =   "Source (left mouse button)"
  276.       ForeColor       =   &H000000FF&
  277.       Height          =   252
  278.       Index           =   0
  279.       Left            =   600
  280.       TabIndex        =   11
  281.       Top             =   3180
  282.       Width           =   2772
  283.    End
  284.    Begin VB.Image imgBlob 
  285.       Height          =   804
  286.       Left            =   2292
  287.       Picture         =   "BITBLAST.frx":8FB4
  288.       Top             =   6480
  289.       Width           =   744
  290.    End
  291. End
  292. Attribute VB_Name = "FBlit"
  293. Attribute VB_GlobalNameSpace = False
  294. Attribute VB_Creatable = False
  295. Attribute VB_PredeclaredId = True
  296. Attribute VB_Exposed = False
  297. Attribute VB_Description = "Blit Test Form"
  298. Option Explicit
  299.  
  300. Private dxBlt As Long, dyBlt As Long
  301. Private pbSrc As PictureBox, pbDst As PictureBox
  302.     
  303. Const ordSrc = 0
  304. Const ordDst = 1
  305.  
  306. Private Sub Form_Load()
  307.  
  308.     Randomize
  309.     ' Initializations
  310.     pbTest(0).Picture = imgHead.Picture
  311.     pbTest(1).Picture = imgBlob.Picture
  312.     pbTest(2).Picture = imgMarble.Picture
  313.     pbTest(3).Picture = imgBlank.Picture
  314.     With pbTest(3)
  315.         dxBlt = ScaleX(.Width, vbTwips, vbPixels)
  316.         dyBlt = ScaleY(.Height, vbTwips, vbPixels)
  317.         pbTest(3).Circle (.Width / 2, .Height / 2), .Width / 3
  318.     End With
  319.     InitRop chkBitBlt = 1
  320.     Set pbSrc = pbTest(0)
  321.     Set pbDst = pbTest(2)
  322.     imgDstPoint.Left = pbDst.Left + (pbDst.Width / 2) - _
  323.                        (imgDstPoint.Width / 2)
  324.     imgSrcPoint.Left = pbSrc.Left + (pbSrc.Width / 2) - _
  325.                        (imgSrcPoint.Width / 2)
  326.     
  327. #If 0 Then
  328.     Show
  329.     ' Default black to blue vertical fade on current form
  330.     Fade Me
  331.     ' Make it blue to black
  332.     Fade Me, LightToDark:=False
  333.     ' Red horizontal fade on FBlit
  334.     Fade FBlit, Red:=True, Horizontal:=True
  335.     ' Violet vertical fade on picture box
  336.     Fade pbTest(0), Red:=True, Blue:=True
  337.     ' Black to white diagonal fade on current form
  338.     Fade Me, Horizontal:=True, Vertical:=True, _
  339.          Red:=True, Green:=True, Blue:=True
  340. #End If
  341.   
  342. End Sub
  343.  
  344. Private Sub chkBitBlt_Click()
  345.     If chkBitBlt = vbChecked Then
  346.         optStretch(0).Visible = True
  347.         optStretch(1).Visible = True
  348.         optStretch(2).Visible = True
  349.     Else
  350.         optStretch(0).Visible = False
  351.         optStretch(1).Visible = False
  352.         optStretch(2).Visible = False
  353.     End If
  354. End Sub
  355.  
  356. Private Sub cmdBlit_Click()
  357.     Dim rop As Long
  358.     rop = lstROP.ItemData(lstROP.ListIndex)
  359.     If chkBitBlt.Value = vbChecked Then
  360.         Call BitBlt(pbDst.hDC, 0, 0, dxBlt, dyBlt, _
  361.                     pbSrc.hDC, 0, 0, rop)
  362.         pbDst.Refresh
  363.     Else
  364.         pbSrc.Picture = pbSrc.Image
  365.         pbDst.PaintPicture pbSrc.Picture, 0, 0, , , , , , , rop
  366.     End If
  367. End Sub
  368.  
  369. Private Sub cmdClear_Click()
  370.     Select Case pbDst.Left
  371.     Case pbTest(0).Left
  372.         'pbDst.Picture = LoadResPicture(100, 0) ' vbResBitMap)
  373.         pbDst.Picture = imgHead.Picture
  374.     Case pbTest(1).Left
  375.         'pbDst.Picture = LoadResPicture(101, vbResBitmap)
  376.         pbDst.Picture = imgBlob.Picture
  377.     Case pbTest(2).Left
  378.         'pbDst.Picture = LoadResPicture(102, vbResBitmap)
  379.         pbDst.Picture = imgMarble.Picture
  380.     Case pbTest(3).Left
  381.         'pbDst.Picture = LoadResPicture(103, vbResBitmap)
  382.         pbDst.Picture = imgBlank.Picture
  383.         pbTest(3).Circle (pbTest(3).Width / 2, _
  384.                           pbTest(3).Height / 2), _
  385.                           pbTest(3).Width / 3
  386.     End Select
  387.     pbDst.Picture = pbDst.Image
  388. End Sub
  389.  
  390. Private Sub cmdExit_Click()
  391.     Unload Me
  392. End Sub
  393.  
  394. ' Secret undocumented command!
  395. Private Sub cmdClear_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  396.     If Button = 3 Then Form_Resize
  397. End Sub
  398.  
  399. ' Secret undocumented command to change fade pattern!
  400. Private Sub cmdExit_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  401.     If Button = 2 Then Form_Resize
  402. End Sub
  403.  
  404. Private Sub cmdMask_Click()
  405.     Dim hdcMono As Long, hbmpMono As Long, hbmpOld As Long
  406.     
  407.     ' Create memory device context
  408.     hdcMono = CreateCompatibleDC(0)
  409.     ' Create monochrome bitmap and select it into DC
  410.     hbmpMono = CreateCompatibleBitmap(hdcMono, dxBlt, dyBlt)
  411.     hbmpOld = SelectObject(hdcMono, hbmpMono)
  412.     ' Copy color bitmap to DC to create mono mask
  413.     BitBlt hdcMono, 0, 0, dxBlt, dyBlt, pbSrc.hDC, 0, 0, SRCCOPY
  414.     ' Copy mono memory mask to visible picture box
  415.     BitBlt pbDst.hDC, 0, 0, dxBlt, dyBlt, hdcMono, 0, 0, SRCCOPY
  416.     pbDst.Refresh
  417.     ' Clean up
  418.     Call SelectObject(hdcMono, hbmpOld)
  419.     Call DeleteDC(hdcMono)
  420.     Call DeleteObject(hbmpMono)
  421. End Sub
  422.  
  423. Private Sub cmdStretch_Click()
  424.     If chkBitBlt.Value = vbChecked Then
  425.         ' Stretch inside out
  426.         Call StretchBlt(hDC, ScaleX(Width, vbTwips, vbPixels) * 0.97, _
  427.                              ScaleY(Height, vbTwips, vbPixels) * 0.9, _
  428.                              -dxBlt * 3.5, -dyBlt * 6.5, _
  429.                              pbSrc.hDC, 0, 0, dxBlt, dyBlt, vbSrcCopy)
  430.         ' Compress backward
  431.         Call StretchBlt(hDC, ScaleX(Width, vbTwips, vbPixels) * 0.75, _
  432.                              ScaleY(Height, vbTwips, vbPixels) * 0.8, _
  433.                              -dxBlt * 0.9, dyBlt * 0.5, _
  434.                              pbSrc.hDC, 0, 0, dxBlt, dyBlt, vbSrcCopy)
  435.     Else
  436.         With pbSrc
  437.             .Picture = .Image
  438.             ' Stretch inside out
  439.             PaintPicture .Picture, Width * 0.97, Height * 0.9, _
  440.                                    -.Width * 3.5, -.Height * 6.5
  441.             ' Compress backward
  442.             PaintPicture .Picture, Width * 0.75, Height * 0.8, _
  443.                                    -.Width * 0.9, .Height * 0.5
  444.         End With
  445.     End If
  446. End Sub
  447.  
  448. Sub InitRop(f As Boolean)
  449.     With lstROP
  450.         If f Then
  451.             .AddItem "SrcCopy"
  452.             .ItemData(.NewIndex) = SRCCOPY
  453.             .AddItem "SrcPaint"
  454.             .ItemData(.NewIndex) = SRCPAINT
  455.             .AddItem "SrcAnd"
  456.             .ItemData(.NewIndex) = SRCAND
  457.             .AddItem "SrcInvert"
  458.             .ItemData(.NewIndex) = SRCINVERT
  459.             .AddItem "SrcErase"
  460.             .ItemData(.NewIndex) = SRCERASE
  461.             .AddItem "NotSrcCopy"
  462.             .ItemData(.NewIndex) = NOTSRCCOPY
  463.             .AddItem "NotSrcErase"
  464.             .ItemData(.NewIndex) = NOTSRCERASE
  465.             .AddItem "MergeCopy"
  466.             .ItemData(.NewIndex) = MERGECOPY
  467.             .AddItem "MergePaint"
  468.             .ItemData(.NewIndex) = MERGEPAINT
  469.             .AddItem "PatCopy"
  470.             .ItemData(.NewIndex) = PATCOPY
  471.             .AddItem "PatPaint"
  472.             .ItemData(.NewIndex) = PATPAINT
  473.             .AddItem "PatInvert"
  474.             .ItemData(.NewIndex) = PATINVERT
  475.             .AddItem "DstInvert"
  476.             .ItemData(.NewIndex) = DSTINVERT
  477.             .AddItem "Blackness"
  478.             .ItemData(.NewIndex) = BLACKNESS
  479.             .AddItem "Whiteness"
  480.             .ItemData(.NewIndex) = WHITENESS
  481.         Else
  482.             .AddItem "SrcCopy"
  483.             .ItemData(.NewIndex) = vbSrcCopy
  484.             .AddItem "SrcPaint"
  485.             .ItemData(.NewIndex) = vbSrcPaint
  486.             .AddItem "SrcAnd"
  487.             .ItemData(.NewIndex) = vbSrcAnd
  488.             .AddItem "SrcInvert"
  489.             .ItemData(.NewIndex) = vbSrcInvert
  490.             .AddItem "SrcErase"
  491.             .ItemData(.NewIndex) = vbSrcErase
  492.             .AddItem "NotSrcCopy"
  493.             .ItemData(.NewIndex) = vbNotSrcCopy
  494.             .AddItem "NotSrcErase"
  495.             .ItemData(.NewIndex) = vbNotSrcErase
  496.             .AddItem "MergeCopy"
  497.             .ItemData(.NewIndex) = vbMergeCopy
  498.             .AddItem "MergePaint"
  499.             .ItemData(.NewIndex) = vbMergePaint
  500.             .AddItem "PatCopy"
  501.             .ItemData(.NewIndex) = vbPatCopy
  502.             .AddItem "PatPaint"
  503.             .ItemData(.NewIndex) = vbPatPaint
  504.             .AddItem "PatInvert"
  505.             .ItemData(.NewIndex) = vbPatInvert
  506.             .AddItem "DstInvert"
  507.             .ItemData(.NewIndex) = vbDstInvert
  508.             .AddItem "Blackness"
  509.             .ItemData(.NewIndex) = vbBlackness
  510.             .AddItem "Whiteness"
  511.             .ItemData(.NewIndex) = vbWhiteness
  512.         End If
  513.         Dim i As Integer
  514.         For i = 0 To .ListCount - 1
  515.             If .List(i) = "SrcCopy" Then
  516.                 .ListIndex = i
  517.                 Exit For
  518.             End If
  519.         Next
  520.     End With
  521.         
  522. End Sub
  523.  
  524.  
  525. Private Sub Form_Resize()
  526.     Dim fRed As Boolean, fGreen As Boolean, fBlue As Boolean
  527.     ' If red, green, and blue are false, you get a black fade
  528.     Do
  529.         fRed = Random(0, 1)
  530.         fGreen = Random(0, 1)
  531.         fBlue = Random(0, 1)
  532.     Loop Until (fRed = True) Or (fGreen = True) Or (fBlue = True)
  533.     Fade Me, Red:=fRed, Green:=fGreen, Blue:=fBlue, _
  534.              Horizontal:=Random(0, 1), Vertical:=Random(0, 1), _
  535.              LightToDark:=Random(0, 1)
  536. End Sub
  537.  
  538. Private Sub lstROP_DblClick()
  539.     cmdBlit_Click
  540. End Sub
  541.  
  542. Private Sub optStretch_Click(Index As Integer)
  543.     Call SetStretchBltMode(Me.hDC, Index + 1)
  544. End Sub
  545.  
  546. Private Sub pbTest_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  547.     Dim ord As Integer
  548.     If Button And 2 Then
  549.         ' Right mouse is destination
  550.         Set pbDst = pbTest(Index)
  551.         imgDstPoint.Left = pbDst.Left + (pbDst.Width / 2) - _
  552.                            (imgDstPoint.Width / 2)
  553.     Else
  554.         ' Other mouse (probably left) is source
  555.         Set pbSrc = pbTest(Index)
  556.         imgSrcPoint.Left = pbSrc.Left + (pbSrc.Width / 2) - _
  557.                            (imgSrcPoint.Width / 2)
  558.     End If
  559. End Sub
  560.